home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp4.arc / SETTRTAB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-07  |  10.0 KB  |  300 lines
  1. (*----------------------------------------------------------------------*)
  2. (*          Set_Translate_Table --- Set Character Translation Table     *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE Set_Translate_Table( File_Name : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Set_Translate_Table                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Gets character translation table                     *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Set_Translate_Table( File_Name : AnyStr );                    *)
  16. (*                                                                      *)
  17. (*           File_Name --- file to read translate table from, if        *)
  18. (*                         specified.                                   *)
  19. (*                                                                      *)
  20. (*      Calls:   ClrScr                                                 *)
  21. (*               Save_Screen                                            *)
  22. (*               Draw_Menu_Frame                                        *)
  23. (*               Restore_Screen                                         *)
  24. (*               Reset_Global_Colors                                    *)
  25. (*                                                                      *)
  26. (*----------------------------------------------------------------------*)
  27.  
  28. VAR
  29.    TrTab_File      : TEXT;
  30.    TrTab_File_Name : AnyStr;
  31.    I               : INTEGER;
  32.    J               : INTEGER;
  33.    K               : INTEGER;
  34.    L_Char          : INTEGER;
  35.    H_Pos           : INTEGER;
  36.    TrTab_Menu      : Menu_Type;
  37.    Done            : BOOLEAN;
  38.    Ch              : CHAR;
  39.    TrTab_Base      : INTEGER;
  40.  
  41. (*----------------------------------------------------------------------*)
  42. (*      Display_Translate_Table -- Display Translate_Table              *)
  43. (*----------------------------------------------------------------------*)
  44.  
  45. PROCEDURE Display_Translate_Table;
  46.  
  47. BEGIN (* Display_Translate_Table *)
  48.  
  49.    GoToXY( 6 , 7 );
  50.  
  51.    L_Char     := 0;
  52.  
  53.    FOR I := 0 TO 15 DO
  54.       BEGIN
  55.  
  56.          GoToXY( 2 , I + 7 );
  57.  
  58.          FOR J := 0 TO 7 DO
  59.             BEGIN
  60.                L_Char :=  ( J * 16 ) + I;
  61.                WRITE( ( TrTab_Base + L_Char):3, '=',
  62.                       ORD(TrTab[CHR(L_Char + TrTab_Base)]):3,'  ');
  63.             END;
  64.  
  65.       END;
  66.  
  67.    GoToXY( 6 , 7 );
  68.  
  69. END   (* Display_Translate_Table *);
  70.  
  71.  
  72. (*----------------------------------------------------------------------*)
  73.  
  74. BEGIN (* Set_Translate_Table *)
  75.  
  76.                                    (* Announce translate table definition *)
  77.    Save_Screen( Saved_Screen );
  78.    Draw_Menu_Frame( 10, 10, 65, 15, Menu_Frame_Color,
  79.                     Menu_Text_Color, 'Read Translate Table Definitions' );
  80.  
  81.    WRITELN;
  82.    WRITE('File with definitions? ');
  83.  
  84.    TrTab_File_Name := File_Name;
  85.  
  86.    IF Length( TrTab_File_Name ) > 0 THEN
  87.       BEGIN
  88.          WRITE(TrTab_File_Name);
  89.          DELAY( One_Second_Delay );
  90.       END
  91.    ELSE
  92.       READLN( TrTab_File_Name );
  93.  
  94.    IF LENGTH( TrTab_File_Name ) <= 0 THEN
  95.       BEGIN (* Get translation definitions from keyboard *)
  96.  
  97.                                    (* Restore previous screen          *)
  98.          Restore_Screen( Saved_Screen );
  99.  
  100.          Reset_Global_Colors;
  101.  
  102.          Save_Screen( Saved_Screen );
  103.          Draw_Menu_Frame( 2, 1, 79, 24, Menu_Frame_Color,
  104.                           Menu_Text_Color, 'Translate Table Definitions' );
  105.  
  106.          ClrScr;
  107.          WRITELN(' Use arrows to move up/down/left/right.');
  108.          WRITELN(' Hit ESC to quit editing and save definitions.');
  109.          WRITELN(' To change character, just type new value, and hit CR.');
  110.          WRITELN(' Hit S to toggle between first and second 128 characters ');
  111.  
  112.                                    (* Display current definitions    *)
  113.  
  114.          TrTab_Base := 0;
  115.  
  116.          Display_Translate_Table;
  117.  
  118.          Done   := FALSE;
  119.          L_Char := 0;
  120.          I      := 1;
  121.          J      := 1;
  122.          H_Pos  := 6;
  123.  
  124.                                    (* Get new definitions *)
  125.          REPEAT
  126.  
  127.             READ( Kbd, Ch );
  128.  
  129.             IF ( Ch = CHR( ESC ) ) THEN
  130.                IF KeyPressed THEN
  131.                   BEGIN  (* Escape sequence found *)
  132.  
  133.                      READ( Kbd , Ch );
  134.  
  135.                      CASE ORD( Ch ) OF
  136.  
  137.                         72:  IF L_Char > 0   THEN L_Char := L_Char - 1;
  138.                         80:  IF L_Char < 255 THEN L_Char := L_Char + 1;
  139.                         77:  IF ( L_Char + 16 ) < 255 THEN
  140.                                 L_Char := L_Char + 16;
  141.                         75:  IF ( L_Char - 16 ) > 0 THEN
  142.                                 L_Char := L_Char - 16;
  143.                         ELSE ;
  144.  
  145.                      END (* CASE *);
  146.  
  147.                      I      := L_Char DIV 16;
  148.                      J      := L_Char - ( I * 16 );
  149.                      H_Pos  := 6 + ( I * 9 );
  150.  
  151.                      GoToXY( H_Pos , J + 7 );
  152.  
  153.                   END   (* Escape sequence found *)
  154.  
  155.                ELSE                (* Lone escape *)
  156.                   Done := TRUE
  157.                                    (* "S" means toggle display *)
  158.  
  159.             ELSE IF UpCase( Ch) = 'S' THEN
  160.                BEGIN
  161.                   TrTab_Base := 128 - TrTab_Base;
  162.                   Display_Translate_Table;
  163.                END
  164.                                    (* Should be digit *)
  165.             ELSE
  166.                BEGIN (* digit *)
  167.  
  168.                   K := 0;
  169.  
  170.                   WHILE( Ch <> CHR( CR ) ) DO
  171.                      BEGIN
  172.  
  173.                         IF Ch IN ['0'..'9'] THEN
  174.                            BEGIN
  175.                               WRITE( Ch );
  176.                               K := K * 10 + ORD( Ch ) - ORD('0');
  177.                            END
  178.                         ELSE IF Ch IN [CHR(BS), CHR(DEL)] THEN
  179.                            BEGIN
  180.                               IF WhereX > H_Pos THEN
  181.                                  BEGIN
  182.                                     GoToXY( WhereX - 1 , WhereY );
  183.                                     WRITE(' ');
  184.                                     GoToXY( WhereX - 1 , WhereY );
  185.  
  186.                                     K := K DIV 10;
  187.                                  END;
  188.                            END;
  189.  
  190.                         READ( Kbd , Ch );
  191.  
  192.                      END;
  193.  
  194.                   IF ( K >= 0 ) AND ( K <= 255 ) THEN
  195.                      BEGIN
  196.                         TrTab[CHR(L_Char + TrTab_Base)] := CHR(K);
  197.                         GoToXY( H_Pos - 4  , J + 7 );
  198.                         WRITE( ( TrTab_Base + L_Char):3, '=', K:3,'  ');
  199.                      END;
  200.  
  201.                END  (* Digit *);
  202.  
  203.          UNTIL  Done;
  204.  
  205.          ClrScr;
  206.          GoToXY( 2 , 5 );
  207.          WRITE('Enter file name to write definitions to (CR to exit): ');
  208.          READLN( TrTab_File_Name );
  209.  
  210.          IF LENGTH( TrTab_File_Name ) > 0 THEN
  211.             BEGIN
  212.  
  213.                IF ( POS( '.', TrTab_File_Name ) = 0 ) THEN
  214.                   TrTab_File_Name := TrTab_File_Name + '.TRA';
  215.  
  216.                ASSIGN( TrTab_File , TrTab_File_Name );
  217.                   (*$I-*)
  218.                REWRITE( TrTab_File );
  219.                   (*$I+*)
  220.  
  221.                IF Int24Result <> 0 THEN
  222.                   BEGIN (* File bad *)
  223.  
  224.                      GoToXY( 2 , 5 );
  225.                      WRITE('*** File ',TrTab_File_Name,' can''t be opened.');
  226.                      ClrEol;
  227.  
  228.                      DELAY( Two_Second_Delay );
  229.  
  230.                   END   (* File bad *)
  231.                ELSE
  232.                   BEGIN (* File OK, definition written *)
  233.  
  234.                      FOR I := 0 TO 255 DO
  235.                         WRITELN( TrTab_File, I:3, ' ', ORD(TrTab[CHR(I)]) );
  236.  
  237.                      CLOSE( TrTab_File );
  238.  
  239.                      GoToXY( 2 , 5 );
  240.  
  241.                      WRITE('Translation table definition written to ',
  242.                             TrTab_File_Name );
  243.  
  244.                      ClrEol;
  245.  
  246.                      DELAY( Two_Second_Delay );
  247.  
  248.                   END   (* File OK, definition written *);
  249.  
  250.             END;
  251.  
  252.       END   (* Get translation table definition from keyboard *)
  253.    ELSE
  254.       BEGIN (* Get definition from file *)
  255.  
  256.          IF ( POS( '.' , TrTab_File_Name ) = 0 ) THEN
  257.             TrTab_File_Name := TrTab_File_Name + '.TRA';
  258.  
  259.          ASSIGN( TrTab_File , TrTab_File_Name );
  260.              (*$I-*)
  261.          RESET ( TrTab_File );
  262.              (*$I+*)
  263.  
  264.          IF Int24Result <> 0 THEN
  265.             BEGIN (* File bad *)
  266.                WRITELN;
  267.                WRITELN('*** File ',TrTab_File_Name,' can''t be found.');
  268.                DELAY( Two_Second_Delay );
  269.             END   (* File bad *)
  270.          ELSE
  271.             BEGIN (* File OK, read definition *)
  272.  
  273.                REPEAT
  274.                       (*$I-*)
  275.                   READLN( TrTab_File , I, J );
  276.                       (*$I+*)
  277.                   IF Int24Result = 0 THEN
  278.                      IF ( I >= 0 ) AND ( I <= 255 ) AND
  279.                         ( J >= 0 ) AND ( J <= 255 ) THEN
  280.                         TrTab[CHR(I)] := CHR( J );
  281.  
  282.                UNTIL( EOF( TrTab_File ) );
  283.  
  284.                WRITELN('Translation table definition loaded.');
  285.  
  286.                DELAY( Two_Second_Delay );
  287.  
  288.                CLOSE( TrTab_File );
  289.  
  290.             END   (* File OK, read definition *);
  291.  
  292.       END   (* Get definition from file *);
  293.  
  294.                                    (* Restore previous screen          *)
  295.    Restore_Screen( Saved_Screen );
  296.  
  297.    Reset_Global_Colors;
  298.  
  299. End   (* Set_Translate_Table *);
  300.